home *** CD-ROM | disk | FTP | other *** search
/ PC Users 1998 March / Pc Users extra 6.iso / pshare95 / prog / formula1 / vcform1.z / frmGolfMain.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1997-09-29  |  22.4 KB  |  565 lines
  1. VERSION 5.00
  2. Object = "{13E51000-A52B-11D0-86DA-00608CB9FBFB}#5.0#0"; "VCF15.OCX"
  3. Begin VB.Form frmGolfMain 
  4.    Caption         =   "VC Formula One Golf Demonstration"
  5.    ClientHeight    =   7695
  6.    ClientLeft      =   2280
  7.    ClientTop       =   1650
  8.    ClientWidth     =   10350
  9.    Icon            =   "frmGolfMain.frx":0000
  10.    LinkTopic       =   "Form1"
  11.    ScaleHeight     =   7695
  12.    ScaleWidth      =   10350
  13.    Begin VB.PictureBox Picture1 
  14.       AutoSize        =   -1  'True
  15.       Height          =   2220
  16.       Left            =   960
  17.       Picture         =   "frmGolfMain.frx":030A
  18.       ScaleHeight     =   2160
  19.       ScaleWidth      =   1620
  20.       TabIndex        =   10
  21.       Top             =   5280
  22.       Width           =   1680
  23.    End
  24.    Begin VB.CommandButton cmdModify 
  25.       Caption         =   "&Modify Person Entries"
  26.       Height          =   495
  27.       Left            =   3720
  28.       TabIndex        =   1
  29.       Top             =   7080
  30.       Width           =   1695
  31.    End
  32.    Begin VB.CommandButton cmdSaveAs 
  33.       Caption         =   "S&ave Scorecard As..."
  34.       Height          =   495
  35.       Left            =   1800
  36.       TabIndex        =   9
  37.       Top             =   4560
  38.       Width           =   1695
  39.    End
  40.    Begin VB.CommandButton cmdCard 
  41.       Caption         =   "G&et Scorecard..."
  42.       Height          =   495
  43.       Left            =   120
  44.       TabIndex        =   8
  45.       Top             =   4560
  46.       Width           =   1695
  47.    End
  48.    Begin VB.CommandButton cmdProcess 
  49.       Caption         =   "&Process and Display Handicaps"
  50.       Height          =   615
  51.       Left            =   3720
  52.       Style           =   1  'Graphical
  53.       TabIndex        =   7
  54.       Top             =   6480
  55.       Width           =   1695
  56.    End
  57.    Begin VB.CommandButton cmdUpdateScores 
  58.       Caption         =   "&Update Scores"
  59.       Height          =   495
  60.       Left            =   3720
  61.       Style           =   1  'Graphical
  62.       TabIndex        =   6
  63.       Top             =   6000
  64.       Width           =   1695
  65.    End
  66.    Begin VB.CommandButton cmdRemove 
  67.       Caption         =   "&Remove Player"
  68.       Height          =   495
  69.       Left            =   3720
  70.       TabIndex        =   4
  71.       Top             =   5520
  72.       Width           =   1695
  73.    End
  74.    Begin VB.CommandButton cmdSelect 
  75.       Caption         =   "&Select Players"
  76.       Height          =   495
  77.       Left            =   3720
  78.       TabIndex        =   3
  79.       Top             =   5040
  80.       Width           =   1695
  81.    End
  82.    Begin VB.CommandButton cmdGet 
  83.       Caption         =   "&Get Players"
  84.       Height          =   495
  85.       Left            =   3720
  86.       TabIndex        =   2
  87.       Top             =   4560
  88.       Width           =   1695
  89.    End
  90.    Begin VCF150Ctl.F1Book F1Players 
  91.       Height          =   3015
  92.       Left            =   5640
  93.       TabIndex        =   5
  94.       Top             =   4560
  95.       Width           =   4575
  96.       _ExtentX        =   8070
  97.       _ExtentY        =   5318
  98.       _0              =   $"frmGolfMain.frx":0FAA
  99.       _1              =   $"frmGolfMain.frx":13B0
  100.       _2              =   $"frmGolfMain.frx":17B5
  101.       _3              =   $"frmGolfMain.frx":1BBA
  102.       _4              =   $"frmGolfMain.frx":1FBF
  103.       _count          =   5
  104.       _ver            =   1
  105.    End
  106.    Begin VCF150Ctl.F1Book f1Scores 
  107.       Height          =   4335
  108.       Left            =   120
  109.       TabIndex        =   0
  110.       Top             =   120
  111.       Width           =   10095
  112.       _ExtentX        =   17806
  113.       _ExtentY        =   7646
  114.       _0              =   $"frmGolfMain.frx":2314
  115.       _1              =   $"frmGolfMain.frx":2719
  116.       _2              =   $"frmGolfMain.frx":2B1F
  117.       _3              =   $"frmGolfMain.frx":2F24
  118.       _4              =   $"frmGolfMain.frx":3329
  119.       _5              =   $"frmGolfMain.frx":372E
  120.       _6              =   $"frmGolfMain.frx":3B33
  121.       _7              =   $"frmGolfMain.frx":3F38
  122.       _8              =   $"frmGolfMain.frx":433D
  123.       _9              =   $"frmGolfMain.frx":4742
  124.       _10             =   $"frmGolfMain.frx":4B47
  125.       _11             =   $"frmGolfMain.frx":4F4D
  126.       _12             =   $"frmGolfMain.frx":5352
  127.       _13             =   $"frmGolfMain.frx":5757
  128.       _14             =   $"frmGolfMain.frx":5B5C
  129.       _15             =   $"frmGolfMain.frx":5F61
  130.       _16             =   $"frmGolfMain.frx":6366
  131.       _17             =   $"frmGolfMain.frx":676B
  132.       _18             =   $"frmGolfMain.frx":6B70
  133.       _19             =   $"frmGolfMain.frx":6F75
  134.       _20             =   $"frmGolfMain.frx":737A
  135.       _21             =   $"frmGolfMain.frx":777F
  136.       _22             =   $"frmGolfMain.frx":7B84
  137.       _23             =   $"frmGolfMain.frx":7F89
  138.       _24             =   $"frmGolfMain.frx":838E
  139.       _25             =   $"frmGolfMain.frx":8793
  140.       _26             =   $"frmGolfMain.frx":8B98
  141.       _27             =   $"frmGolfMain.frx":8F9D
  142.       _28             =   $"frmGolfMain.frx":93A2
  143.       _29             =   $"frmGolfMain.frx":97A7
  144.       _30             =   $"frmGolfMain.frx":9BAC
  145.       _31             =   $"frmGolfMain.frx":9FB1
  146.       _32             =   $"frmGolfMain.frx":A3B6
  147.       _33             =   $"frmGolfMain.frx":A7BB
  148.       _34             =   $"frmGolfMain.frx":ABC0
  149.       _count          =   35
  150.       _ver            =   1
  151.    End
  152.    Begin VCF150Ctl.F1Book F1B 
  153.       Height          =   1695
  154.       Left            =   3840
  155.       TabIndex        =   11
  156.       Top             =   2400
  157.       Visible         =   0   'False
  158.       Width           =   2055
  159.       _ExtentX        =   3625
  160.       _ExtentY        =   2990
  161.       _0              =   $"frmGolfMain.frx":AEC2
  162.       _1              =   $"frmGolfMain.frx":B2C8
  163.       _2              =   $"frmGolfMain.frx":B6CD
  164.       _3              =   $"frmGolfMain.frx":BAD2
  165.       _4              =   $"frmGolfMain.frx":BED7
  166.       _count          =   5
  167.       _ver            =   1
  168.    End
  169.    Begin VB.Menu mnuFile 
  170.       Caption         =   "&File"
  171.       Begin VB.Menu mnuFileExit 
  172.          Caption         =   "E&xit"
  173.       End
  174.    End
  175.    Begin VB.Menu mnuHelp 
  176.       Caption         =   "&Help"
  177.       Begin VB.Menu mnuHelpAbout 
  178.          Caption         =   "&About"
  179.       End
  180.    End
  181. Attribute VB_Name = "frmGolfMain"
  182. Attribute VB_GlobalNameSpace = False
  183. Attribute VB_Creatable = False
  184. Attribute VB_PredeclaredId = True
  185. Attribute VB_Exposed = False
  186. Private Sub GetScores(ss As F1Book, ID As String)
  187.     Dim pQuery As New F1ODBCQuery
  188.     Dim retcode As Integer
  189.     'In this procedure, we clear the existing information and then query
  190.     'the Scores table to get all the scores for a particular person.
  191.     '
  192.     ss.ClearRange -1, -1, -1, -1, F1ClearAll
  193.     With pQuery
  194.         .QueryStr = "SELECT * FROM Scores WHERE ID='" & Trim$(ID) & "'"
  195.         .SetColFormats = False
  196.         .SetColNames = False
  197.         .SetColWidths = False
  198.         .SetMaxRC = False
  199.     End With
  200.     Call ss.ODBCQueryEx(pQuery, 1, 1, False)
  201.     If ss.LastRow > 0 Then 'don't need to sort if no scores exist.
  202.         ss.Sort3 1, 1, ss.LastRow, ss.LastCol, True, 7, 1, 0
  203.     End If
  204. End Sub
  205. Private Sub Update_Handicap(lRow As Long, lCol As Long, ss As F1Book)
  206.     Dim iRetCode%
  207.     ss.Sort3 lRow, 57, lRow, lCol + 57, False, 1, 0, 0
  208.     Select Case lCol
  209.         Case 5, 6 ' Get 1 Lowest Score
  210.             ss.FormulaRC(lRow, 2) = "ROUNDDOWN(Average(" & ss.FormatRCNr(lRow, 57, False) & ":" & ss.FormatRCNr(lRow, 57, False) & "),1)"
  211.                           
  212.         Case 7, 8 ' Get 2 Lowest Scores
  213.             ss.FormulaRC(lRow, 2) = "ROUNDDOWN(Average(" & ss.FormatRCNr(lRow, 57, False) & ":" & ss.FormatRCNr(lRow, 58, False) & "),1)"
  214.                 
  215.         Case 9, 10 ' Get 3 Lowest Scores
  216.             ss.FormulaRC(lRow, 2) = "ROUNDDOWN(Average(" & ss.FormatRCNr(lRow, 57, False) & ":" & ss.FormatRCNr(lRow, 59, False) & "),1)"
  217.             
  218.         Case 11, 12 ' Get 4 Lowest Scores
  219.             ss.FormulaRC(lRow, 2) = "ROUNDDOWN(Average(" & ss.FormatRCNr(lRow, 57, False) & ":" & ss.FormatRCNr(lRow, 60, False) & "),1)"
  220.                 
  221.         Case 12, 14 ' Get 5 lowest scores
  222.             ss.FormulaRC(lRow, 2) = "ROUNDDOWN(Average(" & ss.FormatRCNr(lRow, 57, False) & ":" & ss.FormatRCNr(lRow, 61, False) & "),1)"
  223.             
  224.         Case 15, 16 ' Get 6 Lowest Scores
  225.             ss.FormulaRC(lRow, 2) = "ROUNDDOWN(Average(" & ss.FormatRCNr(lRow, 57, False) & ":" & ss.FormatRCNr(lRow, 62, False) & "),1)"
  226.             
  227.         Case 17 ' Get 7 Lowest Scores
  228.             ss.FormulaRC(lRow, 2) = "ROUNDDOWN(Average(" & ss.FormatRCNr(lRow, 57, False) & ":" & ss.FormatRCNr(lRow, 63, False) & "),1)"
  229.             
  230.         Case 18 ' Get 8 Lowest Scores
  231.             ss.FormulaRC(lRow, 2) = "ROUNDDOWN(Average(" & ss.FormatRCNr(lRow, 57, False) & ":" & ss.FormatRCNr(lRow, 64, False) & "),1)"
  232.         
  233.         Case 19 ' Get 9 Lowest Scores
  234.             ss.FormulaRC(lRow, 2) = "ROUNDDOWN(Average(" & ss.FormatRCNr(lRow, 57, False) & ":" & ss.FormatRCNr(lRow, 65, False) & "),1)"
  235.         
  236.         Case 20 ' Get 10 Lowest Scores
  237.             ss.FormulaRC(lRow, 2) = "ROUNDDOWN(Average(" & ss.FormatRCNr(lRow, 57, False) & ":" & ss.FormatRCNr(lRow, 56, False) & "),1)"
  238.     End Select
  239.             
  240. End Sub
  241. Private Sub cmdCard_Click()
  242.     Dim iRetCode%
  243.     Dim sFileName$
  244.     On Error GoTo CardCancel
  245.     sFileName = f1Scores.OpenFileDlgEx("Get Existing Scorecards", 0)
  246.     iRetCode = f1Scores.ReadEx(sFileName)
  247. CardCancel:
  248.     If Err.Number = 20023 Then 'cancel was selected
  249.        Exit Sub
  250.     End If
  251. End Sub
  252. Private Sub cmdGet_Click()
  253.     Dim pQuery As New F1ODBCQuery
  254.     Dim i%
  255.      
  256.     Call GolfConnect(F1Players)
  257.     With pQuery
  258.         .QueryStr = "SELECT Persons.ID, Persons.FirstName, Persons.LastName, Persons.Handicap FROM Persons"
  259.         .retcode = i
  260.         .SetColFormats = False
  261.         .SetColNames = False
  262.         .SetColWidths = False
  263.         .SetMaxRC = True
  264.     End With
  265.     F1Players.ODBCQueryEx pQuery, 1, 1, False
  266.     F1Players.ODBCDisconnect
  267. End Sub
  268. Private Sub cmdModify_Click()
  269.     frmPerson.Show 1
  270. End Sub
  271. Private Sub cmdProcess_Click()
  272.     Dim ss As F1Book
  273.     Dim iRetCode As Integer
  274.     Dim lRow&, lCol&
  275.     Dim wrkGolf As Workspace
  276.     Dim dbsGolf As Database
  277.     Dim rstGolfPersons As Recordset
  278.     Dim rstGolfScores As Recordset
  279.     Dim PersonsCount&, ScoresCount&
  280.     Dim ScoresQuery$
  281.     iRetCode = MsgBox("This may take a few minutes to run.  Continue?", vbYesNo + vbQuestion, "Process/Update Handicaps")
  282.     If iRetCode = vbNo Then Exit Sub
  283.     frmSplash.Show
  284.     frmSplash.lblNotes.Caption = "Adding a Sheet and getting info."
  285.     frmSplash.Refresh
  286.     Sleep (250)
  287.     Set ss = f1Scores
  288.     ss.InsertSheets 3, 1
  289.     ss.Sheet = 3
  290.     ss.SheetName(ss.Sheet) = "Handicap Info"
  291.     GolfConnect ss
  292.     'Create Workspace
  293.     Set wrkGolf = CreateWorkspace("VciGolf", "admin", "", dbUseJet)
  294.     'Open Golf MDB file
  295.     Set dbsGolf = wrkGolf.OpenDatabase(App.Path & "\golf.mdb")
  296.     'Open Persons and Scores tables
  297.     With dbsGolf
  298.         Set rstGolfPersons = .OpenRecordSet("Persons")
  299.         'Set the column headers
  300.         ss.ColText(1) = "ID"
  301.         ss.ColText(2) = "Handicap"
  302.         ss.ColText(3) = "FirstName"
  303.         ss.ColText(4) = "LastName"
  304.         ss.ColText(5) = "Differential"
  305.         
  306.         rstGolfPersons.MoveLast
  307.         'Loop through Records to Get ID, FName, & LName
  308.         For PersonsCount = rstGolfPersons.RecordCount - 1 To 0 Step -1
  309.             
  310.             'Put ID, FName, & LName in cells.
  311.             ss.TextRC(PersonsCount + 1, 1) = rstGolfPersons.Fields("ID").Value
  312.             ss.TextRC(PersonsCount + 1, 3) = rstGolfPersons.Fields("FirstName").Value
  313.             ss.TextRC(PersonsCount + 1, 4) = rstGolfPersons.Fields("LastName").Value
  314.             
  315.             'Select all score differentials where scores.id = current persons.id
  316.             ScoresQuery = "SELECT Differential FROM Scores WHERE " & _
  317.                           "ID = '" & rstGolfPersons.Fields("ID").Value & _
  318.                           "' ORDER BY sDate"
  319.             Set rstGolfScores = .OpenRecordSet(ScoresQuery)
  320.             
  321.             rstGolfScores.MoveLast
  322.             'Plug differentials into next 0 to 20 columns of current row.
  323.             For ScoresCount = rstGolfScores.RecordCount - 1 To 0 Step -1
  324.                 ss.NumberRC(PersonsCount + 1, ScoresCount + 5) = rstGolfScores.Fields("Differential").Value
  325.                 rstGolfScores.MovePrevious
  326.             Next ScoresCount
  327.             
  328.             rstGolfPersons.MovePrevious
  329.         Next PersonsCount
  330.         
  331.         rstGolfPersons.Close
  332.         
  333.     End With
  334.     dbsGolf.Close
  335.     wrkGolf.Close
  336.     'Copy the range to a location outside the visible region.
  337.     'This will allow to sort/order the scores for easier calculations
  338.     'of the handicaps
  339.     frmSplash.lblNotes.Caption = "Rearranging data to do Calculations"
  340.     frmSplash.Refresh
  341.     Call ss.CopyRangeEx(ss.Sheet, 1, 57, ss.LastRow, 76, ss.ss, ss.Sheet, 1, 5, ss.LastRow, 24)
  342.     frmSplash.lblNotes.Caption = "Calculating the handicaps"
  343.     frmSplash.Refresh
  344.     For lRow = ss.LastRow To 1 Step -1
  345.         
  346.         For lCol = 3 To 23
  347.             'Get the number of scores the person has reported.
  348.             If ss.TypeRC(lRow, lCol) = 0 Then
  349.                 lCol = lCol - 1
  350.                 Exit For
  351.             End If
  352.         Next lCol
  353.             
  354.         'since the columns started on the 3rd column, subtracting 2 from lcol _
  355.          will give the actual number of scores the person has.  We cannot calculate _
  356.          handicaps unless at least 5 scores have been posted.
  357.         If lCol - 2 < 5 Then
  358.             ss.TextRC(lRow, 2) = "N/A"
  359.         Else
  360.             Call Update_Handicap(lRow, lCol - 2, ss)
  361.             'After getting handicaps updated, need to update persons info w/ new _
  362.              handicap
  363.             iRetCode = ss.ODBCPrepareEx("UPDATE Persons SET Handicap=? WHERE ID=?")
  364.             iRetCode = ss.ODBCBindParameterEx(1, 2, F1CDataDouble) 'Handicap
  365.             iRetCode = ss.ODBCBindParameterEx(2, 1, F1CDataChar) 'ID
  366.             
  367.             iRetCode = ss.ODBCExecuteEx(lRow, lRow)
  368.         End If
  369.             
  370.     Next lRow
  371.                             
  372.     f1Scores.Sheet = 3
  373.     f1Scores.SetColWidthAuto -1, 1, -1, 5, False ' the '-1' will set width to header if necessary
  374.     f1Scores.SetSelection 1, 1, 1, 1
  375.     Unload frmSplash
  376. End Sub
  377. Private Sub cmdRemove_Click()
  378.     'Deletes current row(s)
  379.     f1Scores.EditDelete F1ShiftRows
  380. End Sub
  381. Private Sub cmdSaveAs_Click()
  382.     Dim ss As F1BookView
  383.     Dim pFileInfo As New F1FileSpec
  384.     Dim i&
  385.     Set ss = New F1BookView
  386.     On Error GoTo f1Cancel
  387.     'Creating a Formula One BookView so the unwanted information _
  388.      can be cleared and saved to disk without interupting _
  389.      existing spreadsheet.  Otherwise, copies and pastes would _
  390.      need to be done to get it to work.  This method will be more "behind the _
  391.      scenes" so the user will be less likely to notice.
  392.      
  393.     'Copy info from Spreadsheet to new F1BookView created _
  394.      where f1Scores is the name of the existing Formula One workbook.
  395.     ss.CopyAll f1Scores.ss
  396.     'set up file name and type info
  397.     pFileInfo.Name = f1Scores.Title
  398.     pFileInfo.Type = F1FileFormulaOne3
  399.     'check to make sure handicap info is not saved w/ scorecard
  400.     For i = 1 To ss.NumSheets
  401.         ss.Sheet = i
  402.         If ss.SheetName(i) = "Handicap Info" Then
  403.             ss.DeleteSheets i, 1
  404.             Exit For
  405.         End If
  406.     Next i
  407.     'set the first sheet sheet to be current
  408.     ss.Sheet = 1
  409.     'save the window settings w/ the workbook: Max/Min/Fixed..., _
  410.      Allow..., Show..., active sheet, etc.
  411.     ss.SaveWindowInfo
  412.     'clear out the current players
  413.     ss.ClearRange 4, 1, 1000, 26, F1ClearValues
  414.     'Cannot use the save file dialog with a F1BookView _
  415.      because there is no window
  416.     f1Scores.SaveFileDlgEx "Save current scorecard information", pFileInfo
  417.     ss.WriteEx pFileInfo.Name, pFileInfo.Type
  418.     Exit Sub
  419. f1Cancel:
  420.     If Err.Number = 20023 Then 'cancel was selected in save file dlg.
  421.         Exit Sub
  422.     Else
  423.         Resume Next
  424.     End If
  425. End Sub
  426. Private Sub cmdSelect_Click()
  427.     Dim iSelCount%, i%, iType%
  428.     Dim pr1&, pc1&, pr2&, pc2&, lCount&, lRow&
  429.     Dim objSelection As F1RangeRef
  430.     'Initialize the Row variable from where the search will be started.
  431.     lRow = 2
  432.     'Loop through to find the first empty row
  433.     Do
  434.         lRow = lRow + 1
  435.         iType = f1Scores.TypeRC(lRow, 1)
  436.     Loop Until iType = 0 'Empty cell
  437.     f1Scores.Selection = "A" & Trim$(Str$(lRow))
  438.     ' Get the selection
  439.     iSelCount = F1Players.SelectionCount
  440.     For i = 0 To iSelCount - 1
  441.         'F1Players.GetSelection i, pr1, pc1, pr2, pc2
  442.         Set objSelection = F1Players.SelectionEx(i)
  443.         
  444.         'since there can be more than one row per selection and/or _
  445.          multiple selections, we need to not only get the total number _
  446.          of selections, but each row(s) in each selection, if in fact _
  447.          there are multiple selections.
  448.         For lCount = objSelection.StartRow To objSelection.EndRow
  449.             'Set Players' names and handicaps on 'score card'
  450.             f1Scores.TextRC(lRow, 1) = F1Players.TextRC(lCount, 1)
  451.             f1Scores.EntryRC(lRow, 23) = F1Players.EntryRC(lCount, 4)
  452.                         
  453.             lRow = lRow + 1
  454.         Next lCount
  455.     Next i
  456.     'Need to copy formulas down for the calculations, _
  457.      formulas, and totals, if not on the first row of players
  458.     f1Scores.AutoRecalc = False
  459.     f1Scores.Repaint = False
  460.     f1Scores.CopyRangeEx 1, 6, 11, lRow - 1, 11, f1Scores.ss, 1, 5, 11, 5, 11 'Front Nine
  461.     f1Scores.CopyRangeEx 1, 6, 21, lRow - 1, 21, f1Scores.ss, 1, 5, 21, 5, 21 'Back Nine
  462.     f1Scores.CopyRangeEx 1, 6, 22, lRow - 1, 22, f1Scores.ss, 1, 5, 22, 5, 22 'Total Gross score
  463.     f1Scores.CopyRangeEx 1, 6, 24, lRow - 1, 24, f1Scores.ss, 1, 5, 24, 5, 24 'Net Score
  464.     f1Scores.CopyRangeEx 1, 6, 25, lRow - 1, 25, f1Scores.ss, 1, 5, 25, 5, 25 'Rating
  465.     f1Scores.CopyRangeEx 1, 6, 26, lRow - 1, 26, f1Scores.ss, 1, 5, 26, 5, 26 'Slope
  466.     f1Scores.CopyRangeEx 1, 6, 27, lRow - 1, 27, f1Scores.ss, 1, 5, 27, 5, 27 'Date of round
  467.     'the ags sheet starts scores on row 4 instead of row 5, hence the "lRow - 1" below
  468.     f1Scores.CopyRangeEx 2, 5, 1, lRow - 2, 27, f1Scores.ss, 2, 4, 1, 4, 27 'formulas on AGS
  469.     f1Scores.Repaint = True
  470.     f1Scores.AutoRecalc = True
  471. End Sub
  472. Private Sub cmdUpdateScores_Click()
  473.     Dim ss As F1Book
  474.     Dim lRow&, LastRow&
  475.     Dim lCount&
  476.     Dim iRetCode%
  477.     Dim pQuery As F1ODBCQuery
  478.     Dim sPrepare$
  479.     Me.MousePointer = vbHourglass
  480.     frmSplash.Show
  481.     frmSplash.lblNotes.Caption = "Updating Scores"
  482.     Sleep (250)
  483.     'Attach View so that action can be done behind the scenes w/o user noticing
  484.     Set ss = F1B
  485.     'ss.InitTable
  486.     ss.Attach f1Scores.Title
  487.     'Check to make sure a sheet did not get inserted before 'Adg. Gross Scores' Sheet
  488.     'then set its information into the database fields.
  489.     For lCount = 1 To ss.NumSheets
  490.         ss.Sheet = lCount
  491.         If ss.SheetName(lCount) = "Adjusted Gross Scores" Then
  492.             ss.SetSelection 4, 1, 4, 1
  493.             Exit For
  494.         End If
  495.     Next lCount
  496.     'check to see if there are scores to udpate.
  497.     If ss.TypeRC(4, 1) = 0 Then
  498.         MsgBox "There are no scores to update.", vbOKOnly, "Update Score"
  499.         Unload frmSplash
  500.         Me.Refresh
  501.         Exit Sub
  502.     End If
  503.     'Connect AGS sheet to our Golf DB
  504.     GolfConnect ss
  505.     LastRow = ss.LastRow
  506.     'Insert New sheet and connect it to our Golf db.  This sheet will be used to verify and
  507.     'update up to 20 scores.  If there are 20 scores, the newest score will replace
  508.     'the oldest score.
  509.     ss.InsertSheets 3, 1
  510.     ss.Sheet = 3
  511.     GolfConnect ss
  512.        
  513.     For lRow = 4 To LastRow
  514.         
  515.         If ss.TypeSRC(2, lRow, 1) <> 0 Then 'score info is most likely available
  516.             frmSplash.lblNotes.Caption = "Updating Row " & Str$(lRow - 3)
  517.             frmSplash.Refresh
  518.             ss.SetSelection lRow, 1, lRow, 1
  519.             Call GetScores(ss, ss.TextSRC(2, lRow, 1))
  520.             
  521.             'need to check to see how many scores are in the db for the particular _
  522.              person as the handicap is determined on at least five scores and not _
  523.              than 20 scores.  In the GetScores procedure, the scores were sorted by _
  524.              date so that the
  525.             If ss.LastRow < 20 Then
  526.                 ss.Sheet = lCount
  527.                 'Add new score to scores table
  528.                 sPrepare = "INSERT INTO Scores (ID, AdjScore, CourseRating, Slope, Differential, sDate) VALUES (?, ?, ?, ?, ?, ?)"
  529.             Else
  530.                 ss.Sheet = lCount
  531.                 'replace oldest score w/ newest one.
  532.                 sPrepare = "UPDATE Scores SET ID=?, AdjScore=?, CourseRating=?, Slope=?, Differential=?, sDate=? WHERE ScoreID='" & ss.TextSRC(3, 1, 1) & "'"
  533.             End If
  534.                 
  535.             iRetCode = ss.ODBCPrepareEx(sPrepare)
  536.             iRetCode = ss.ODBCBindParameterEx(1, 1, F1CDataChar) 'ID
  537.             iRetCode = ss.ODBCBindParameterEx(2, 22, F1CDataDouble) 'AdjScore (Adjusted)
  538.             iRetCode = ss.ODBCBindParameterEx(3, 24, F1CDataDouble) 'Course Rating
  539.             iRetCode = ss.ODBCBindParameterEx(4, 25, F1CDataLong) 'Slope
  540.             iRetCode = ss.ODBCBindParameterEx(5, 26, F1CDataDouble) 'Differential
  541.             iRetCode = ss.ODBCBindParameterEx(6, 27, F1CDataDate) 'Date of Round.
  542.             
  543.             iRetCode = ss.ODBCExecuteEx(lRow, lRow)
  544.         End If
  545.         ss.Sheet = 3
  546.     Next lRow
  547.     'disconnect from the newly created sheet
  548.     ss.Sheet = 3
  549.     ss.ODBCDisconnect
  550.     'disconnect from scores (AGS) sheet
  551.     ss.Sheet = lCount
  552.     ss.ODBCDisconnect
  553.     'Delete newly create sheet
  554.     ss.DeleteSheets 3, 1
  555.     ss.Attach ""
  556.     Unload frmSplash
  557.     Me.MousePointer = vbDefault
  558. End Sub
  559. Private Sub mnuFileExit_Click()
  560.     End
  561. End Sub
  562. Private Sub mnuHelpAbout_Click()
  563.     frmHelp.Show 1
  564. End Sub
  565.